home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / LgcyPlus / disk2 / BMAPWDGT._ / BMAPWDGT.
Encoding:
Text File  |  2001-03-02  |  6.4 KB  |  191 lines
  1. 10    ! ***********************************************************
  2. 20    ! Example: BITMAP Widget
  3. 30    !
  4. 40    ! This program demonstrates the use of the BITMAP widget. It
  5. 50    ! allows you to bring in and display bitmaps, as well as select
  6. 60    ! portions of them and save them in a file.
  7. 70    !
  8. 80    ! It also demonstrates the SCROLLABLE attribute for the PANEL,
  9. 90    ! such as the various operations needed to make SCROLL WIDTH
  10. 100   ! and SCROLL HEIGHT as correct as possible.
  11. 110   !
  12. 120   ! ***********************************************************
  13. 130   !
  14. 140   ! Variables used:
  15. 150   !
  16. 160   !   S$:   General-purpose string
  17. 170   !   N:    General-purpose variable
  18. 180   !   Btn:  Returns button value from dialogs
  19. 190   !   Sc:   Scroll factor
  20. 200   !   Bitfile$: Name of bitmap file to be read
  21. 210   !   Dirname$: Directory name returned from FILE dialog
  22. 220   !   B1$(*):   Stores MENU BUTTONS
  23. 230   !   A1$,A2$:  Stores dialog attributes
  24. 240   !
  25. 250   DIM S$[256]
  26. 260   INTEGER N,Btn,Sc
  27. 270   DIM Bitfile$[100],Dirname$[100],Btns$(1:3)[50],A1$[50],A2$[50]
  28. 280   !
  29. 290   DATA "BMP File","XWD File","Cancel","DIALOG BUTTONS","SELECTION",20
  30. 300   READ Btns$(*),A1$,A2$,Sc
  31. 310   !
  32. 320   ! Widget dimensions
  33. 330   !
  34. 340   INTEGER Pw,Ph,Px,Py,Iw,Ih,Ww,Wh,Wx,Wy
  35. 350   !
  36. 360   ! Variables for display scaling
  37. 370   !
  38. 380   INTEGER Cursor,D(1:4),Dw,Dh
  39. 390   !
  40. 400   ! Get display size
  41. 410   !
  42. 420   GESCAPE CRT,3;D(*)
  43. 430   Dw=D(3)-D(1)
  44. 440   Dh=D(4)-D(2)
  45. 450   !
  46. 460   CLEAR SCREEN
  47. 470   !
  48. 480   Pw=Dw*.7  ! PANEL width
  49. 490   Ph=Dh*.7  ! PANEL height
  50. 500   Px=(Dw-Pw)/2 ! Center PANEL
  51. 510   Py=(Dh-Ph)/2
  52. 520   !
  53. 530   ! Create PANEL for BITMAP widget. The SCROLL WIDTH and
  54. 540   ! HEIGHT are set to a small value so that scroll bars
  55. 550   ! will not appear initially. The actual heights are set
  56. 560   ! later to fit the bitmap that has been loaded.
  57. 570   !
  58. 580   ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
  59. 590   CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  60. 600   CONTROL @Main;SET ("TITLE":" Example: BITMAP Widget")
  61. 610   CONTROL @Main;SET ("SIZE CONTROL":"SCROLLABLE","MINIMIZABLE":1)
  62. 620   CONTROL @Main;SET ("SCROLL WIDTH":1,"SCROLL WIDTH UNITS":Sc)
  63. 630   CONTROL @Main;SET ("SCROLL HEIGHT":1,"SCROLL HEIGHT UNITS":Sc)
  64. 640   !
  65. 650   ! Build menu
  66. 660   !
  67. 670   ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
  68. 680   CONTROL @Menu;SET ("LABEL":"Menu")
  69. 690   ASSIGN @Getfile TO WIDGET "MENU BUTTON";PARENT @Menu
  70. 700   CONTROL @Getfile;SET ("LABEL":"Get Bitmap File")
  71. 710   ASSIGN @Savefile TO WIDGET "MENU BUTTON";PARENT @Menu
  72. 720   CONTROL @Savefile;SET ("LABEL":"Cut Bitmap To File")
  73. 730   ASSIGN @Cd TO WIDGET "MENU BUTTON";PARENT @Menu
  74. 740   CONTROL @Cd;SET ("LABEL":"Change Directory")
  75. 750   ASSIGN @S TO WIDGET "MENU SEPARATOR";PARENT @Menu
  76. 760   ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
  77. 770   CONTROL @Quit;SET ("LABEL":"Quit")
  78. 780   !
  79. 790   ! Create and size BITMAP widget. (Setting RETAIN RASTER makes
  80. 800   ! the widget redraw quickly when overwritten by a dialog.)
  81. 810   !
  82. 820   ASSIGN @Bitmap TO WIDGET "BITMAP";PARENT @Main
  83. 830   CONTROL @Bitmap;SET ("RETAIN RASTER":1,"AUTO SIZE":1)
  84. 840   STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  85. 850   Wx=Iw*.01
  86. 860   Wy=Ih*.01
  87. 870   Wh=Ih*.98
  88. 880   Ww=Iw*.98
  89. 890   CONTROL @Bitmap;SET ("X":Wx,"Y":Wy,"WIDTH":Ww,"HEIGHT":Wh)
  90. 900   !
  91. 910   ! Set events
  92. 920   !
  93. 930   ON EVENT @Getfile,"ACTIVATED" GOSUB Getbitfile
  94. 940   ON EVENT @Savefile,"ACTIVATED" GOSUB Savebits
  95. 950   ON EVENT @Cd,"ACTIVATED" GOSUB Chdir
  96. 960   ON EVENT @Quit,"ACTIVATED" GOTO Finis
  97. 970   !
  98. 980   CONTROL @Main;SET ("VISIBLE":1)
  99. 990   !
  100. 1000  ! Loop and wait for input
  101. 1010  !
  102. 1020  LOOP
  103. 1030    WAIT FOR EVENT
  104. 1040  END LOOP
  105. 1050  STOP
  106. 1060  !
  107. 1070  ! ************** End of Main Program **********************
  108. 1080  !
  109. 1090  ! This routine gets a bitmap file and displays it. It gets
  110. 1100  ! the bitmap size and sets up PANEL scrolling accordingly.
  111. 1110  ! Also, it makes the BITMAP widget invisible so the display
  112. 1120  ! will "thrash" as little as possible.
  113. 1130  !
  114. 1140 Getbitfile: !
  115. 1150  S$="Please enter the name of a bitmap (.XWD or .BMP) file:"
  116. 1160  DIALOG "FILE",S$,Btn;RETURN ("SELECTION":Bitfile$)
  117. 1170  !
  118. 1180  IF Btn=0 THEN
  119. 1190    CLEAR ERROR
  120. 1200    ON ERROR GOSUB Errtrap
  121. 1210    CONTROL @Bitmap;SET ("VISIBLE":0,"BITMAP FILE":Bitfile$)
  122. 1220    OFF ERROR
  123. 1230    IF ERRN<>0 THEN
  124. 1240      DIALOG "ERROR","Can't open file / invalid bitmap file."
  125. 1250      CONTROL @Bitmap;SET ("BITMAP FILE":"","VISIBLE":1)
  126. 1260    ELSE
  127. 1270      CONTROL @Bitmap;SET ("VISIBLE":0)
  128. 1280      STATUS @Bitmap;RETURN ("BITMAP HEIGHT":Wh,"BITMAP WIDTH":Ww)
  129. 1290      CONTROL @Main;SET ("SCROLL HEIGHT":2+INT(Wh/Sc))
  130. 1300      CONTROL @Main;SET ("SCROLL WIDTH":2+INT(Ww/Sc))
  131. 1310      CONTROL @Bitmap;SET ("VISIBLE":1)
  132. 1320      DIALOG "INFORMATION","File read completed"
  133. 1330    END IF
  134. 1340  END IF
  135. 1350  RETURN
  136. 1360  !
  137. 1370  ! This routine allows you to cut a section of a bitmap and
  138. 1380  ! save it in a file. String variables are used in the FILE
  139. 1390  ! dialog to specify the DIALOG BUTTONS attribute and the
  140. 1400  ! SELECTION attribute to keep a compact statement length.
  141. 1410  !
  142. 1420 Savebits: !
  143. 1430  S$="Enter file name, then click-and-drag image to save:"
  144. 1440  DIALOG "FILE",S$,Btn;SET (A1$:Btns$(*)),RETURN (A2$:Bitfile$)
  145. 1450  !
  146. 1460  SELECT Btn
  147. 1470  CASE 0
  148. 1480    S$="BMP"   ! Dump format is MS-Windows .BMP file.
  149. 1490  CASE 1
  150. 1500    S$="XWD"   ! Dump format is X11 XWD format.
  151. 1510  CASE 2
  152. 1520    RETURN
  153. 1530  END SELECT
  154. 1540  !
  155. 1550  CLEAR ERROR
  156. 1560  ON ERROR GOSUB Errtrap
  157. 1570  CONTROL @Bitmap;SET ("DUMP FORMAT":S$,"DUMP AREA":Bitfile$)
  158. 1580  OFF ERROR
  159. 1590  IF ERRN<>0 THEN
  160. 1600    DIALOG "ERROR","Can't open file."
  161. 1610  ELSE
  162. 1620    DIALOG "INFORMATION","Bitmap saved to "&S$&" file."
  163. 1630  END IF
  164. 1640  !
  165. 1650  RETURN
  166. 1660  !
  167. 1670  ! This routine changes directories
  168. 1680  !
  169. 1690 Chdir: !
  170. 1700  S$="Please enter the name of a directory:"
  171. 1710  DIALOG "FILE",S$,Btn;RETURN ("DIRECTORY":Dirname$)
  172. 1720  !
  173. 1730  Err=0
  174. 1740  CLEAR ERROR
  175. 1750  ON ERROR GOSUB Errtrap
  176. 1760  MASS STORAGE IS Dirname$
  177. 1770  OFF ERROR
  178. 1780  IF ERRN<>0 THEN
  179. 1790    DIALOG "ERROR","Can't change directory"
  180. 1800  END IF
  181. 1810  RETURN
  182. 1820  !
  183. 1830  ! Dummy routine for trapping errors
  184. 1840  !
  185. 1850 Errtrap: ERROR RETURN
  186. 1860  !
  187. 1870 Finis: !
  188. 1880  ASSIGN @Main TO *   ! Delete PANEL widget
  189. 1890  CLEAR SCREEN
  190. 1900  END
  191.